home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 010 / crosword.bas (.txt) < prev    next >
Encoding:
GW-BASIC  |  1985-09-15  |  5.1 KB  |  264 lines
  1. 10  CLEAR 1000
  2. 20  PRINT "HIDDEN WORDS II"
  3. 30  RANDOMIZE
  4. 50  NU$="": REM No spaces between quotes
  5. 60  SL$=" ":REM One space between quotes
  6. 70  EC$=" ":REM One space between quotes
  7. 80  LC$="#"
  8. 90  QT$=CHR$(34): REM Double quote
  9. 100  INPUT "How many rows(1-50)";MR
  10. 110  INPUT "How many columns (1-50)";MC
  11. 120  IF MR<1 OR MR>50 OR MC<1 OR MC>50 THEN 100
  12. 130  NC=MR*MC
  13. 140  NW=0
  14. 150  READ WD$
  15. 160  IF WD$="/" THEN 190
  16. 170  NW=NW+1
  17. 180  GOTO 150
  18. 190  READ ND
  19. 200  DIM M$(MR,MC), RI(ND), CI(ND), SQ(NC), WD$(NW), WU(NW), WQ(NW)
  20. 210  RESTORE
  21. 220  FOR J=1 TO NW
  22. 230  READ WD$(J)
  23. 240  NEXT J
  24. 250  READ WD$
  25. 260  READ ND
  26. 270  FOR J=1 TO ND
  27. 280  READ RI(J),CI(J)
  28. 290  NEXT J
  29. 300  PRINT "Erasing the puzzle grid."
  30. 310  FOR J=1 TO MR
  31. 320  FOR K=1 TO MC
  32. 330  IF M$(J,K)<>EC$ THEN M$(J,K)=LC$
  33. 340  NEXT K
  34. 350  NEXT J
  35. 360  PRINT "Puzzle design menu"
  36. 370  PRINT "  1-Print current design"
  37. 380  PRINT "  2-Change design from keyboard"
  38. 390  PRINT "  3-Load new design from disk"
  39. 400  PRINT "  4-Save design to disk"
  40. 410  PRINT "  5-Generate a puzzle"
  41. 420  PRINT "  6-End"
  42. 430  INPUT CH
  43. 440  IF CH<1 AND CH>6 THEN 360
  44. 450  ON CH GOTO 460,510,720,880,1000,2480
  45. 460  GOSUB 2600:GOSUB 2700:REM Let user specify alternate output device & select it
  46. 470  MG$=NU$
  47. 480  GOSUB 2490
  48. 490  GOSUB 2800: REM Restore normal output device
  49. 500  GOTO 360
  50. 510  PRINT "Enter starting row (SR) and ending row (ER)"
  51. 520  PRINT "1 <= SR <=ER <=";MR
  52. 530  PRINT "(Enter 0,0 for Menu)"
  53. 540  INPUT SR,ER
  54. 550  IF ER=0 AND SR=0 THEN 360
  55. 560  IF SR<1 OR ER>MR OR ER<SR THEN 510
  56. 570  PRINT "Enter starting column (SC) and ending column (EC)"
  57. 580  PRINT "1 <= SC <= EC <=";MC
  58. 590  INPUT SC,EC
  59. 600  IF SC<1 OR EC>MC OR EC<SC THEN 570
  60. 610  PRINT "Fill area with: 1-blanks  2-letters"
  61. 620  INPUT "Select 1 or 2";BL
  62. 630  IF BL<>1 AND BL<>2 THEN 610
  63. 640  IF BL=1 THEN FC$=EC$
  64. 650  IF BL=2 THEN FC$=LC$
  65. 660  FOR J=SR TO ER
  66. 670  FOR K=SC TO EC
  67. 680  M$(J,K)=FC$
  68. 690  NEXT K
  69. 700  NEXT J
  70. 710  GOTO 510
  71. 720  FI$=NU$
  72. 730  LINE INPUT "Name the input file: ";FI$
  73. 740  IF FI$=NU$ THEN 360
  74. 750  OPEN "I",1,FI$
  75. 760  FOR J=1 TO MR
  76. 770  FOR K=1 TO MC
  77. 830  INPUT #1, M$(J,K)
  78. 840  NEXT K
  79. 850  NEXT J
  80. 860  CLOSE 1
  81. 870  GOTO 360
  82. 880  FO$=NU$
  83. 890  LINE INPUT "Name the output file: ";FO$
  84. 900  IF FO$=NU$ THEN 360
  85. 910  OPEN "O",1,FO$
  86. 920  FOR J=1 TO MR
  87. 930  FOR K=1 TO MC
  88. 940  PRINT #1,QT$;M$(J,K);QT$
  89. 950  NEXT K
  90. 960  NEXT J
  91. 970  CLOSE 1
  92. 980  PRINT "The design is stored in disk file ";FO$
  93. 990  GOTO 360
  94. 1000  PRINT "Sorting the word list"
  95. 1010  FOR J=1 TO NW
  96. 1020  WQ(J)=J
  97. 1030  NEXT J
  98. 1040  SF=0
  99. 1050  FOR J=1 TO NW-1
  100. 1060  IF LEN(WD$(WQ(J))) >=LEN(WD$(WQ(J+1))) THEN 1110
  101. 1070  T=WQ(J)
  102. 1080  WQ(J)=WQ(J+1)
  103. 1090  WQ(J+1)=T
  104. 1100  SF=1
  105. 1110  NEXT J
  106. 1120  IF SF=1 THEN 1040
  107. 1130  PRINT "Shuffling the cell numbers"
  108. 1140  FOR J=1 TO NC
  109. 1150  SQ(J)=0
  110. 1160  NEXT J
  111. 1170  FOR J=1 TO NC
  112. 1180  Q=INT(RND(1)*NC)+1
  113. 1190  IF SQ(Q) <>O THEN 1180
  114. 1200  SQ(Q)=J
  115. 1210  NEXT J
  116. 1220  FOR J=1 TO NW
  117. 1230  WU(J)=-1
  118. 1240  NEXT J
  119. 1250  PRINT "Filling in the puzzle"
  120. 1260  P=1
  121. 1270  QP=0
  122. 1280  WA=NW
  123. 1290  DI=INT(RND(1)*ND)+1
  124. 1300  PRINT "Pass #";P
  125. 1310  QP=QP+1
  126. 1320  NF=1
  127. 1330  CP=SQ(QP)
  128. 1340  CR=INT((CP-1)/MC)+1
  129. 1350  CC=CP-(CR-1)*MC
  130. 1360  IF M$(CR,CC)=EC$ OR (P=2 AND M$(CR,CC)=LC$) THEN 1880
  131. 1370  IF WA<>0 THEN 1410
  132. 1380  PRINT
  133. 1390  PRINT "Used all the words"
  134. 1400  GOTO 2110
  135. 1410  Q=1
  136. 1420  W=WQ(Q)
  137. 1430  W$=WD$(W)
  138. 1440  WL=LEN(W$)
  139. 1450  DK=1
  140. 1460  RX=CR+(WL-1)*RI(DI)
  141. 1470  CX=CC+(WL-1)*CI(DI)
  142. 1480  IF RX<1 OR RX>MR OR CX<1 OR CX>MC THEN 1800
  143. 1490  NF=0
  144. 1500  PR=CR
  145. 1510  PC=CC
  146. 1520  FOR L=1 TO WL
  147. 1530  T$=M$(PR,PC)
  148. 1540  IF T$=EC$ THEN 1580
  149. 1550  IF T$=LC$ THEN 1600
  150. 1560  L$=MID$(W$,L,1)
  151. 1570  IF L$=T$ THEN 1600
  152. 1580  L=WL
  153. 1590  NF=1
  154. 1600  PR=PR+RI(DI)
  155. 1610  PC=PC+CI(DI)
  156. 1620  NEXT L
  157. 1630  IF NF=1 THEN 1800
  158. 1640  PR=CR
  159. 1650  PC=CC
  160. 1660  FOR L=1 TO WL
  161. 1670  M$(PR,PC)=MID$(W$,L,1)
  162. 1680  PR=PR+RI(DI)
  163. 1690  PC=PC+CI(DI)
  164. 1700  NEXT L
  165. 1710  IF Q=WA THEN 1750
  166. 1720  FOR J=Q TO WA-1
  167. 1730  WQ(J)=WQ(J+1)
  168. 1740  NEXT J
  169. 1750  WA=WA-1
  170. 1760  WU(W)=(DI-1)*NC+CP-1
  171. 1770  DI=DI+1
  172. 1780  IF DI>ND THEN DI=1
  173. 1790  GOTO 1880
  174. 1800  IF DK=ND THEN 1850
  175. 1810  DK=DK+1
  176. 1820  DI=DI+1
  177. 1830  IF DI>ND THEN DI=1
  178. 1840  GOTO 1460
  179. 1850  IF Q=WA THEN 1880
  180. 1860  Q=Q+1
  181. 1870  GOTO 1420
  182. 1880  IF NF=1 THEN PRINT "C";
  183. 1890  IF NF=0 THEN PRINT "W";
  184. 1900  IF QP=NC THEN 2060
  185. 1910  GOTO 1310
  186. 1915  K$=INKEY$
  187. 1920  IF K$=NU$ THEN 1310
  188. 1930  PRINT "Puzzle-in-Progress Menu"
  189. 1940  PRINT "1-Continue 2-Show puzzle"
  190. 1950  PRINT "3-Show unused words 4-Random fill"
  191. 1960  INPUT CH
  192. 1970  IF CN<1 AND CH>4 THEN 1940
  193. 1980  ON CH GOTO 1310,1990,2020,2110
  194. 1990  MG$=NU$
  195. 2000  GOSUB 2490
  196. 2010  GOTO 1940
  197. 2020  FOR JJ=1 TO NW
  198. 2030  IF WU(JJ)=-1 THEN PRINT WD$(JJ)
  199. 2040  NEXT JJ
  200. 2050  GOTO 1940
  201. 2060  PRINT
  202. 2070  IF P=2 THEN 2110
  203. 2080  P=2
  204. 2090  QP=0
  205. 2100  GOTO 1300
  206. 2110  PRINT "Filling in the empty cells at random"
  207. 2120  FOR CR=1 TO MR
  208. 2130  FOR CC=1 TO MC
  209. 2140  IF M$(CR,CC)<>LC$ THEN 2160
  210. 2150  M$(CR,CC)=CHR$(INT(RND*26)+65)
  211. 2160  NEXT CC
  212. 2170  NEXT CR
  213. 2180  PRINT
  214. 2190  PRINT "Puzzle completed."
  215. 2200  PRINT
  216. 2210  GOSUB 2600: REM Ask user to specify output device
  217. 2220  INPUT "Press RETURN when ready to print";D$
  218. 2230  GOSUB 2700: REM Select alternate output device
  219. 2240  MG$=SL$
  220. 2250  GOSUB 2490
  221. 2260  PRINT
  222. 2270  GOSUB 2800: REM Restore normal output device
  223. 2280  INPUT "Press return for hidden word directory ";D$
  224. 2290  GOSUB 2700: REM Select alternate output device
  225. 2300  PRINT
  226. 2310  PRINT "The hidden words are:"
  227. 2320  PRINT "Word"; TAB(20); "Row"; TAB(26); "Col."; TAB(32); "Direction"
  228. 2330  FOR J=1 TO NW
  229. 2340  IF WU(J)=-1 THEN 2400
  230. 2350  DI=INT(WU(J)/NC)+1
  231. 2360  CP=WU(J)-(DI-1)*NC+1
  232. 2370  CR=INT((CP-1)/MC)+1
  233. 2380  CC=CP-(CR-1)*MC
  234. 2390  PRINT WD$(J); TAB(20); CR; TAB(26); CC; TAB(32); DI
  235. 2400  NEXT J
  236. 2410  PRINT
  237. 2420  GOSUB 2800: REM Restore normal output device
  238. 2430  PRINT
  239. 2440  PRINT "Puzzle generation menu"
  240. 2450  INPUT "Select: 1-Reprint 2-New Puzzle 3-End ";CH
  241. 2460  IF CH<1 AND CH>3 THEN 2450
  242. 2470  ON CH GOTO 2200,300,2480
  243. 2480  SYSTEM
  244. 2490  FOR TR=1 TO MR
  245. 2500  FOR TC=1 TO MC
  246. 2510  PRINT M$(TR,TC);MG$;
  247. 2520  NEXT TC
  248. 2530  PRINT
  249. 2540  NEXT TR
  250. 2550  RETURN
  251. 2600  INPUT "OUTPUT TO 1-CRT 2-PRINTER";DV
  252. 2610  IF DV<1 OR DV>2 THEN 2600
  253. 2620  RETURN
  254. 2700  IF DV=2 THEN PRINT CHR$(16);
  255. 2710  RETURN
  256. 2800  IF DV=2 THEN PRINT CHR$(16);
  257. 2810  RETURN
  258. 5000  DATA KIRK, TEDDY, MATTHEW, BILL, GINI
  259. 5010  DATA PAT, MIKE, SAM, MERF, FRISKY, CURIOUS
  260. 5020  DATA PACKWOOD, JOSEPH, DAVID, MARY, WILLIAM, THEODORE
  261. 5030  DATA /
  262. 6000  DATA 8
  263. 6010  DATA 0,1, 1,1, 1,0, 1,-1, 0,-1, -1,-1, -1,0, -1,1
  264.